perm filename NOTWRT.F4[MSS,LCS]5 blob sn#107255 filedate 1974-06-15 generic text, type T, neo UTF8
00100	C******* NOTWRT -  RJBX ***********
00200		SUBROUTINE NOTWRT
00300		IMPLICIT INTEGER(A-Q,S-Z)
00400		COMMON/DL/IXRX,M,AA
00500		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600		DIMENSION SU(250),RACNT(52),RDOT(7),XAC(6)
00700		REAL DIS,PWDS,CENTR,POS,STFF
00800		COMMON /STF/RSTFAC(8),RSTJC
00900		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
01000		COMMON/PLTR/PLT,RHT,DIS/XRN/RN(4000)/POSI/STFF(8),JJB,POS
01100		COMMON/NW/FILL(7),RNOTE(24)
01200		COMMON /NU/NUMQ(44),RNUMS(327),RACCI(32),NACCI(3)
01300	C   FOR NOTE DRAWING
01400		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJD,RJQ(2))
01500		1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
01600		1,(JK,JQ(9)),(JF,JQ(4)),(RJE,RJQ(3)),(SU(1),RN(3001))
01700		1,(RJH,RJQ(6)),(RJG,RJQ(5)),(RX,JRX)
01800		DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
01900		1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02000		1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02100		1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02200		1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02300		1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008/
02400		DATA RDOT/1000.0, 0.103, 1.0, 1.103, 2.0, 2.103,0/
02500		1 , R5/5.0/, R66/66.0/, R72/72.0/,R18/18.0/,RSTM/14.54/
02600		1 ,XAC/9,14,18,28,33,44/
02700	C   ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
02800		RST3=3.*RSTJC
02900		RST7=7.*RSTJC
03000		RSTX=RSTJC
03100	C  FOR MINIS AT 245
03200	
03300	1	CENTR=POS-R18*RSTJC+AMOD(RJD,100.0)*RST7
03400	C   'CENTR' IS VERTICAL PLACEMENT
03500		IF(JA.EQ.9)GO TO 90
03600		RMINI=RSTJC
03700	C  OR SHOULD THIS ONLY BE IN NOTES, ETC?  15/9/72
03800	
03900		IF(JA.EQ.101)GO TO 110
04000		RJB=JB
04100		RINV=1
04200	551	GO TO (11,20,30,241,50,242,70,80,90,11,30,80),JA
04300		IF(JA.EQ.30)GO TO 571
04400	C   FOR BEAMS.
04500	90	CALL ITMSUB
04600		RETURN
04700	
04800	20	IF(JE.GT.1)RJD=RJD-2
04900	CC	RA=RJD
05000		RJG=RJF*10.
05100	C  FOR DOTS
05200	202	CALL REST
05300		IF(JE.GT.1)GO TO 200
05400		IF(RJG.EQ.0)RETURN
05500	CC201	L=14
05600	CC	IF(JE)L=19
05700	CC	JB=JB+L*RSTJC
05800	CC	RJD=8.+RA
05900	201	RA=14
06000		IF(JE)RA=19
06100		JB=RJB+RA*RSTJC
06200		RJD=8.+RJD
06300		JA=6
06400		JE=7
06500	C   IF P6=1 THE REST IS DOTTED
06600		GO TO 1
06700	200	JE=JE-1
06800	C  FOR MULTIPLE TAILS ON 16TH REST, ETC.
06900		RJD=RJD+2.
07000		CALL RJBX(4.3)
07100		GO TO 202
07200	80	CALL SLUR
07300		RETURN
07400	
07500	C  FOR TREMOLO SLASHES
07600	571	RJB=RJB+1
07700		RX=14.*RSTJC
07800		RJX=CENTR+RST7
07900		RJY=RJX-RX
08000		IF(MOD(JE,10).NE.0)RJY=RJX
08100	C  11 OR 21 IN P5 MAKE LEVEL BEAMS
08200		IF(JE.LT.20)GO TO 42
08300		CALL EXCH(RJX,RJY)
08400		RJB=RJB-RX+1
08500	42	RX=RJB+26*RSTJC
08600		DO 40 K=1,JF
08700		DO 41 L=0,2
08800		RA=L*RSTJC
08900	41	CALL LINX(RJB,RJX+RA,RX,RJY+RA)
09000		RJX=RJX+RST7
09100	40	RJY=RJY+RST7
09200		RETURN
09300	
09400	C FOR USER-DRAWN LIBRARY OF SYMBOLS
09500	30	CALL CLEFS
09600		RETURN
09700	291	CALL RJBX(8.)
09800		IF(RINV)CENTR=CENTR-RST3
09900	C  REMOVE '8' LATER
10000		CENTR=CENTR+2*RSTJC
10100	
10200	29	RJX=RJB
10300		RJY=CENTR+RSTJC
10400	108	CALL RDRAW(1,7.0,RDOT,RSTJC,RJX,RJY,RSTJC)
10500		IF(JA.EQ.1.OR.RJG.GE.20.)GO TO 290
10600		RB=POS+52.*RSTJC
10700		IF(RJY.NE.RB)GO TO 6241
10800	C   WHERE IS RB USED LATER?
10900		RJY=RJY-12*RSTJC
11000		GO TO 108
11100	C  ABOVE FOR DOTS
11200	290	RJG=RJG-10.
11300		IF(RJG.LT.10.)GO TO 1342
11400		RJX=RJX+RSTJC*13.
11500		GO TO 108
11600	
11700	
11800	C  FOR LEDGER LINES
11900	70	JK=JD
12000	C   NOTE #
12100	170	RJW=RJB-9.*RMINI
12200		RJZ=RJB+22.*RMINI
12300		IF(JK)GO TO 71
12400		JX=JK
12500		JRX=13
12600	C********* 18/9/72
12700		GO TO 711
12800	71	JX=-JK
12900		JRX=JK*2+3
13000	711	RX=POS-18*RSTJC+RST7*JRX
13100	C********* 18/9/72
13200		IF(JF)RJZ=RJZ+2*RMINI
13300	C126	IF(PLT.EQ.-3)GO TO 1126
13400	C  FOR 2-PASS PLOTTING
13500	C   ******* ABOVE IS NOT USED, 15/9/72
13600	126	CALL LINX(RJW,RX,RJZ,RX)
13700	1126	IF(JX.EQ.1)GO TO 1122
13800		RX=RX+RSTJC*14.
13900		JX=JX-1
14000		GO TO 126
14100	1122	IF(JA.EQ.7)RETURN
14200		JI=-1
14300		GO TO 1121
14400	
14500	C  NOTES****
14600	C	RACTX=ABS(AMOD(RJF,1.0))*10.
14700	11	RJF=ABS(AMOD(RJF,1.0))*10.
14800	C   RJF WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
14900	1011	RG=19.0
15000		KL=1
15100		IF(PLT.NE.-1)RG=14.
15200	C  FOR 2-PASS PLOTTING
15300		RJAC=RJB
15400	C   TO SAVE POS. OF NOTE FOR ACCENT
15500	1015	L=IABS(JD)
15600		STEM=JE/10
15700		IF(L.LT.100)GO TO 1221
15800		IF(L.LT.200)GO TO 1012
15900		KL=20
16000		IF(L.GE.300)GO TO 1014
16100		RG=24.0
16200	C  FOR DIAMOND NOTES.
16300		GO TO 1013
16400	1014	RJX=RMINI*7
16500		RX=RJB+RSTM*RMINI
16600		RA=CENTR-RJX
16700		RB=CENTR+RJX
16800		CALL LINX(RJB,RA,RX,RB)
16900		CALL LINX(RJB,RB,RX,RA)
17000		IF(STEM.EQ.2)RB=RA
17100		GO TO 1013
17200	1012	RMINI=.6*RSTJC
17300	C  FOR RMINI NOTES
17400	1013	JD=MOD(JD,100)
17500	CC	RJD=RJD-100.
17600		RJD=AMOD(RJD,100.)
17700	CC	IF(RJD.GT.160.)GO TO 1013
17800	C  FOR MINI TAILS AND ACCIS. ETC.
17900	1221	JY=IABS(JF)
18000		IF(JY.LT.10.OR.JY.GE.30)GO TO 2221
18100	C P6 FOR HOMING TO RIGHT(10,30) OR LEFT(20) OF STEM(10,30=UP, 20=DOWN)
18200	C P6<0 = WHITE NOTE
18300		RQ=RSTM
18400		IF(JF)RQ=RQ+1.66
18500	C GETS WIDTH OF NOTE DISPLACEMENT
18600		IF(JY.EQ.20)RQ=-RQ
18700		RJB=RJB+RQ*RMINI
18800	2221	IF((JD.GT.1.AND.JD.LT.13).OR.JI.NE.0)GO TO 1121
18900	C   ARE THERE LEDGER LINES?
19000		JK=(JD+1)/2-6
19100		IF(JK)JK=-((3-JD)/2)
19200		GO TO 170
19300	C  IF JF≠0 NOTE IS FILLED IN
19400	1121	IF(JF.GE.0.AND.KL.EQ.1)GO TO 125
19500		IF(L.GE.300)GO TO 123
19600	C  JUMP IF 'X' NOTE.
19700		CALL RDRAW(KL,RG,RNOTE,RMINI,RJB,CENTR,RMINI)
19800		GO TO 123
19900	125	IF(PLT)GO TO 1251
20000		CALL LINES(RJB,CENTR,3)
20100		RG=4.0
20200		GO TO 1253
20300	1251	CALL NOIR(RMINI)
20400		GO TO 123
20500	
20600	1253	RG=RMINI*RG
20700		RA=RJB+RG
20800		DO 1252 K=1,7,3
20900		RB=FILL(K)*RMINI
21000		CALL LINES(RA,CENTR+RB,2)
21100		CALL LINES(RA,CENTR-RB,2)
21200	1252	RA=RA+RG
21300	C   ABOVE IS NEW NOTES ROUTINE
21400	
21500	123	RJE=RJE-JE
21600	C  RJE=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
21700		IF(STEM.EQ.0)GO TO 1242
21800		IF(L.LT.300)RB=CENTR
21900	C  ≥300 IS FOR 'X' NOTES.
22000	128	JG=MOD(JG,10)
22100		RG=(JG-1)*14
22200		IF(RG)RG=0
22300		IF(RJH.GE.999)RJH=0
22400	C   NO EXTEN. OF STEM?
22500		RH=RJH*RST7
22600	C  STEM EXTENSIONS ARE BY NOTE #S
22700		IF(STEM.NE.2)GO TO 1280
22800		RJX=RJB
22900	C  FOR STEM DOWN (=2)
23000		RG=-RG-48.
23100		RH=-RH
23200		L=20
23300		RJY=3.
23400		RJD=RJD-3.7-RJH
23500	C RJD IS USED IN SUBR. TAIL   - RJH IS STEM EXTENSION.
23600		RJW=-2
23700		RA=1.
23800		GO TO 129
23900	C  NEXT IS FOR STEM UP.
24000	1280	RJX=RSTM
24100		RJW=2
24200	C  FOR VERT. SPACING OF MULTIPLE TAILS
24300		RJD=RJD-2+RJH
24400	C  2 ABOVE AND 3.7 BEFORE ARE BECAUSE ORIG. POS. OF TAIL DRWING IS OFF.
24500		IF(JF.NE.0.AND.JF.NE.30)RJX=16.2
24600	C  FOR HALF NOTES
24700		RJX=RJX*RMINI+RJB
24800		RG=RG+48.
24900		L=10
25000		RJY=-3.
25100		RA=-1.
25200	129	RJZ=CENTR+RH+RG*RMINI
25300		IF(RMINI.NE.RSTJC)RJW=RJW*.6
25400		CALL LINX(RJX,RB,RJX,RJZ)
25500	C  RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
25600	227	JE=JE-L
25700	C   JE HAS ACCID. # NOW
25800		IF(JG.EQ.0)GO TO 1242
25900	C   JUMP IF NO TAILS
26000	127	CALL TAIL(RJX,RA,RMINI)
26100	1028	JG=JG-1
26200		IF(JG.EQ.0)GO TO 327
26300		RJD=RJD+RJW
26400	C  MOVES CENTR UP OR DOWN FOR NEXT TAIL
26500		GO TO 127
26600	327	IF(JJ.EQ.0)GO TO 1242
26700		RJY=RJZ-19*RSTJC
26800		RJZ=RJZ-RSTJC*4.
26900		IF(RA.LT.0)GO TO 1327
27000	C  NEXT IS FOR STEM DOWN SLASH
27100		RJY=RJZ+23*RSTJC
27200		RJZ=RJZ+RST7
27300	1327	RJX=RJX-RST7
27400		CALL LINX(RJX,RJY,RJX+17.*RSTJC,RJZ)
27500	C  FOR SLASH ON GRACE NOTE TAIL
27600	1242	IF(RJG.LT.10.)GO TO 1342
27700	C  FOR DOTTED NOTE-- P7>9 
27800		RJX=RJAC+(24.+AMOD(RJG,1.0)*59.6)*RMINI
27900		RJY=CENTR+RSTJC
28000		IF(JY.EQ.10.OR.JY.EQ.30)RJX=RJX+RSTM
28100	C  MOVES DOT TO LEFT
28200		IF(MOD(JD,2).EQ.0)GO TO 108
28300		RX=RST7
28400		IF(JY.GE.20)RX=-RX
28500	3342	RJY=RJY+RX
28600		GO TO 108
28700	C  JY=30= STEM UP, INTERVAL OF SECOND.
28800	1342	RJB=RJB-RJE*59.6*RMINI
28900	C  TO SPACE OUT ACCIDS.
29000		IF(RMINI.NE.RSTJC)RSTJC=.7*RSTJC
29100	C   ↑↑↑↑		  ↑↑↑↑↑ WAS RMINI
29200	C********* 18/9/72
29300	242	IF(JE.GE.0)GO TO 2421
29400		RINV=-RINV
29500		JE=-JE
29600	C  NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
29700	C********** LAST # WAS 281?
29800	C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
29900	2421	RH=14
30000		IF(JA.NE.6)GO TO 211
30100		CALL NOZERO(RJF)
30200	C  RJF=SIZE FACTOR  (P6)
30300		RMINI=RMINI*RJF
30400		RJF=0
30500		STEM=0
30600	C   FOR MISC. ITEMS
30700	210	IF(IABS(JD).LT.100)GO TO 3241
30800		JD=MOD(JD,100)
30900		RMINI=.7*RMINI
31000	3241	JEX=-1
31100	C FOR 2 MARKS AT ONCE.
31200	1241	IF(JE.GE.11)GO TO 28
31300		GO TO (211,211,211,28,28,222,249,60,27,27),JE
31400		RETURN
31500	C  ERROR TRAP (I.E. JE=0)
31600	
31700	241	CALL LINES(RJB,CENTR,3)
31800		GO TO 210
31900	
32000	2422	IF(RJF.EQ.0)RETURN
32100		RJB=RJAC
32200		JE=(RJF+.001)*100.
32300	1249	IF(MOD(JE,10).GT.3)GO TO 249
32400		JE=JE/10
32500		IF(JE.GT.30)GO TO 1249
32600	C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
32700	249	IF(JE.GT.30)GO TO 28
32800		IF(JE.GT.10)GO TO 246
32900		IF(JA.NE.1)GO TO 250
33000		RH=8
33100		RB=14.
33200		IF((JE.NE.7.AND.JE.NE.9).OR.MOD(JD,2).EQ.0)GO TO 244
33300		IF((STEM.LE.1.AND.JD.LT.5).OR.((STEM.EQ.2.OR.STEM.EQ.0)
33400		1 .AND.JD.GT.9))GO TO 244
33500		RB=21
33600	C   PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
33700	244	IF(STEM.EQ.1.OR.(STEM.EQ.0.AND.JD.LT.7))RB=-RB
33800		IF(JE.NE.6)GO TO 245
33900		IF(JD.LT.9.AND.STEM.EQ.2)GO TO 247
34000		IF(JD.GT.4.AND.STEM.EQ.1)GO TO 252
34100	245	CENTR=CENTR+RB*RSTX
34200	250	IF(JE.GT.10.OR.JE.LT.6)GO TO 247
34300		JA=6
34400		IF(JE.NE.7)GO TO 253
34500	C   7=DOT
34600		RXX=RJB
34700		RJB=RJB+6.7*RMINI
34800	C  CENTERS THE DOT
34900		GO TO 29
35000	253	IF(JE.EQ.9)GO TO 271
35100	C   9=DASH
35200	251	IF(RB.LT.0)RINV=-RINV
35300	C   FIX THIS!!!!  FOR BOWINGS, ETC.
35400	222	CALL FERMTA(RINV)
35500		GO TO 5241
35600	252	RX=POS
35700	248	CENTR=RX
35800		GO TO 251
35900	246	IF(STEM.EQ.1)RB=70.
36000		IF(STEM.EQ.2)RB=21.
36100	C  CHANGE R66 AND R72 TO NUMS WHEN RIGHT ONES ARE FOUND.
36200		GO TO 245
36300	247	RX=POS+R72*RSTJC
36400		IF(JE.EQ.6.OR.JE.EQ.26)GO TO 248
36500	C  26 IS NEW NUMB FOR FERMATA. TAKE OUT 6 EVENTUALLY.
36600		IF(JA.EQ.1.AND.JE.GT.10.AND.CENTR.LT.RX)CENTR=RX
36700	28	IF(JE.LT.30)GO TO 281
36800		JEX=MOD(JE,10)
36900	C  JEX SAVES NEXT MARK.
37000		IF(JEX.LT.4)JEX=0
37100		JE=JE/10
37200		IF(JE.GT.30)RETURN
37300	C  WON'T READ 415 ETC. (CORRECT=154)
37400	C DOES BOTTOM MARK FIRST, THEN TOP.
37500		CALL EXCH(JEX,JE)
37600	C  PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
37700		IF(JA.EQ.1)GO TO 249
37800		GO TO 1241
37900	281	X=1
38000		IF(JE.NE.4)GO TO 228
38100		X=5
38200		CALL RJBX(.5)
38300		GO TO 328
38400	228	IF(JE.GT.10)X=XAC(JE-10)
38500	C   X IS POINTER IN RACNT ARRAY
38600	328	RA=RMINI
38700	C   OR RSTJC?
38800		IF(RINV.LT.0.OR.(STEM.EQ.1.AND.JE.EQ.4))RA=-RA
38900		CALL RDRAW(X+1,RACNT(X),RACNT,RA,RJB,CENTR,RMINI)
39000	C              PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
39100	C  IN ARRAY, 33.012 WOULD BE X=33, Y=12.  101.123 IS X=-1, Y=-23.
39200		GO TO 5241
39300	4241	JJJ=JE
39400		JE=JEX
39500		JEX=-1
39600		IF(JA.NE.1)GO TO 7241
39700		IF(JE.GT.10)GO TO 246
39800		IF(JE.EQ.7.AND.JJJ.NE.9)GO TO 249
39900	7241	RXX=RH*RMINI
40000		IF(STEM.EQ.1)RXX=-RXX
40100		CENTR=CENTR+RXX
40200		IF(JE.EQ.26)JE=6
40300	C  TEMPORARY?? FIX
40400		GO TO 1241
40500	C >=5,  ∧=4
40600	27	RJB=JB
40700	C  DASHES
40800	271	CALL LINX(RJB,CENTR,RJB+RSTJC*14.,CENTR)
40900	5241	IF(JEX.GT.0)GO TO 4241
41000	C JEX IS FOR DOUBLE MARKS.  (WHAT ABOUT DOT POSITION.)
41100		RETURN
41200	6241	RJB=RXX
41300	C  RESET RJB AFTER A DOT.
41400		GO TO 5241
41500	211	IF(JE.EQ.0)GO TO 2422
41600		IF(JE.GT.3)GO TO 222
41700	C  FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
41800		X=NACCI(JE)
41900		CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,RJB,CENTR,RMINI)
42000		GO TO 2422
42100	
42200	500	RJB=RJB-RST3
42300		JJB=JJB-RSTJC*13.
42400	C   ADJUSTS POS. OF #S
42500		JE=JE-1
42600		GO TO 222
42700	C NUMS- 5, POS, STF, NT#, P5=SZ(DECI'S), P6=NUM(>0=LETTERS),P7=1=BDR40
42800	50	IF(JG.NE.0.AND.PLT)GO TO 52
42900		RDIS=RJE
43000		JJJ=JF
43100		CALL NOZERO(RDIS)
43200		PUNCT=0
43300		IF(JJJ.LT.44)GO TO 51
43400		PUNCT=JJJ
43500		IF(JJJ.EQ.44)JJJ=38
43600		IF(JJJ.GE.45)JJJ=36
43700		IF(JF.NE.46)GO TO 51
43800		RXX=4
43900		CALL RJBX(-RXX)
44000		RX=16
44100		CENTR=CENTR+RX*RSTJC
44200	51	RX=RDIS*RSTJC
44300	451	X=NUMQ(JJJ+1)
44400	C  X=END # OF ITEM
44500	C  X+1=1ST PART OF ITEM
44600	      CALL RDRAW(X+1,RNUMS(X),RNUMS,RX,RJB,CENTR+RST3,RX)
44700		IF(PUNCT.EQ.0)GO TO 151
44800		IF(PUNCT.NE.46)GO TO 351
44900		CALL RJBX(2.*RXX)
45000	C  FOR "
45100	651	PUNCT=0
45200		GO TO 451
45300	351	RXX=11
45400	C FOR : AND ;
45500		CENTR=CENTR+RXX*RSTJC
45600		JJJ=38
45700		GO TO 651
45800	151	IF(JA.EQ.101)GO TO 1005
45900		RETURN
46000	52	CALL MAKNUM(RJF)
46100		RETURN
46200	
46300	110	JC=RJB
46400		IF(JC.NE.99)GO TO 1008
46500		CALL HYDPOG(2)
46600		RETURN
46700	1008	JF=0
46800		JE=0
46900		RSTJC=1.
47000	C  SETS UP SCALE LINES.
47100		RJC=STFF(JC+4)+60 
47200		RJ=RJC+60
47300		CENTR=RJC+74
47400		CALL DPYSET(2,SU,250)
47500		CALL DPYBRT(1)
47600	1001	POS=RJC+64
47700		DO 1002 MX=10,200,10
47800		RA=RHORZ(FLOAT(MX))
47900		RJB=RA-58
48000		IF(MX.GT.10)GO TO 50
48100	1005	IF(RJE.NE.0)GO TO 1007
48200	C  JUMP FOR STAFF NUMBERS
48300		CALL LINX(RA,RJC,RA,RJ)
48400		JF=JF+1
48500	1002	IF(JF.EQ.10)JF=0
48600		CALL LINES(-596.0,RJ,2)
48700		CALL LINES(-596.0,RJC,2)
48800		RJE=1.5
48900	C  NEXT SETS UP STAFF NUMBERS
49000		RJB=-620.
49100		DO 1007 K=-3,4
49200		CENTR=STFF(K+4)+21.
49300		JF=IABS(K)
49400		GO TO 50
49500	1007	CONTINUE
49600		CALL DPYOUT(2)
49700		CALL SETPOG(1)
49800		RETURN
49900	
50000	C  FOR 1 OR 2 BAR REP SIGNS.
50100	60	CALL BREP(RJB,RSTJC)
50200		END
50300	
50400		SUBROUTINE RJBX(R)
50500	       COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RSTFAC(8),RSTJC
50600		RJB=RJB+R*RSTJC
50700		END